home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Resources / Audio, Video & Photo / Audacity 1.3.5 / audacity-win-unicode-1.3.5.exe / {app} / Plug-Ins / clicktrack.ny < prev    next >
Lisp/Scheme  |  2007-11-07  |  6KB  |  189 lines
  1. ;nyquist plug-in
  2.  
  3. ;version 3
  4.  
  5. ;type generate
  6.  
  7. ;name "Click Track..."
  8.  
  9. ;action "Generating Click Track..."
  10.  
  11. ;info "Written by Dominic Mazzoni, modified by David R. Sky\nReleased under terms of the GNU General Public License version 2\nGenerates a click track at the given tempo and beats per measure, using the\nclick sound type you choose below. To start the click track after time zero,\nenter the starting point in start-time-offset.\nTo create metronome-like click track, set beats-per-measure value to 1 or 2. \nPitches are set using MIDI numbers for example:\nC notes: 48, 60 [middle C], 72, 84, 96."
  12.  
  13.  
  14.  
  15. ;control tempo "Tempo [beats per minute]" int "" 120 30 300
  16. ;control sig "Beats per measure [bar]" int "" 4 1 20
  17. ;control measures "Number of measures [bars]" int "" 16 1 1000
  18. ;control offset "Start time offset [seconds]" real "" 0 0 30
  19. ;control click-type "Click sound type" choice "ping,noise,tick" 0
  20. ;control q "Noise click resonance [q] [higher gives more defined pitch]" int "" 1 1 20
  21. ;control high "MIDI pitch of strong click" int "" 92 18 116
  22. ;control low "MIDI pitch of weak click" int "" 80 18 116
  23.  
  24. ; original clicktrack.ny by Dominic Mazzoni,
  25. ; modified by David R. Sky September 2007
  26. ; original code kept 'as is'.
  27. ; now includes:
  28. ; choice between click sounds [ping {sinewave}, noise or tick],
  29. ; user-set MIDI pitch values for strong and weak clicks,
  30. ; resonance of noise clicks 
  31. ; [higher resonance gives noise clicks more discernable pitch],
  32. ; time offset for start of click track,
  33. ; and error-checking code to generate error message
  34. ; for such things as negative value inputs
  35. ; Drip sound generator by Paul Beach,
  36. ; used with permission.
  37.  
  38. (setf click-type (+ click-type 1))
  39.  
  40.  
  41. ; check function: returns 1 on error
  42. ; min and max are allowable min and max values for arg
  43. (defun check (arg min max)
  44. (if (and (>= arg min) (<= arg max))
  45. 0 1))
  46.  
  47.  
  48. ; initialize blank error-msg
  49. (setf error-msg "")
  50.  
  51. ; input values error checks
  52. ; tempo
  53. (setf error-msg (if 
  54. (= (check tempo 30 300) 0)
  55. error-msg
  56. (strcat error-msg (format nil
  57. "Tempo ~a outside valid range 30 to 300 bpm
  58. " tempo))))
  59. ; beats per measure
  60. (setf error-msg (if
  61. (= (check sig 1 20) 0)
  62. error-msg
  63. (strcat error-msg (format nil
  64. "Beats per measure ~a outside valid range 1 to 20
  65. " sig))))
  66. ; number of measures
  67. (setf error-msg (if
  68. (= (check measures 1 1000) 0)
  69. error-msg
  70. (strcat error-msg (format nil
  71. "Number of measures ~a outside valid range 1 to 1000
  72. " measures))))
  73. ; time start offset
  74. (setf error-msg (if
  75. (= (check offset 0 30) 0)
  76. error-msg
  77. (strcat error-msg (format nil
  78. "Time offset ~a outside valid range 0 to 30 seconds
  79. " offset))))
  80. ; q
  81. (setf error-msg (if
  82. (= (check q 1 20) 0)
  83. error-msg
  84. (strcat error-msg (format nil
  85. "Filter quality q ~a outside valid range 1 to 20
  86. " q))))
  87. ; high MIDI pitch
  88. (setf error-msg (if
  89. (= (check high 18 116) 0)
  90. error-msg
  91. (strcat error-msg (format nil
  92. "High MIDI pitch ~a outside valid range 18 to 116
  93. " high))))
  94. ; low MIDI pitch
  95. (setf error-msg (if
  96. (= (check low 18 116) 0)
  97. error-msg
  98. (strcat error-msg (format nil
  99. "Low MIDI pitch ~a outside valid range 18 to 116
  100. " low))))
  101.  
  102.  
  103. (cond
  104. ; if error-msg is not blank, give error msg
  105. ((> (length error-msg) 0)
  106. (setf error-msg (strcat (format nil
  107. "Error - \n\nYou have entered at least one invalid value:
  108. ") error-msg))) ; end error msg
  109.  
  110. ; no error so generate click track
  111. (t
  112. (setf ticklen 0.01) ; duration of 1 click
  113. (setf beatlen (/ 60.0 tempo))
  114.  
  115.  
  116. ; function to generate drip sound clicks
  117. ; code by Paul Beach www.proviewlandscape.com/liss/
  118. ; stretch-abs function makes this sound more like 'tick' sounds
  119. (defun drip (p) ; p is pitch in hz
  120. (lp 
  121. (stretch 1
  122. (mult (exp-dec 0 0.015 0.25) 
  123. ( sim
  124. (mult (hzosc (*  2.40483  p))  0.5 )
  125. (mult (hzosc (*  5.52008  p))  0.25 )
  126. (mult (hzosc (* 8.653  p))  0.125 )
  127. (mult (hzosc (* 11.8  p))  0.0625 )
  128. )
  129. )
  130. ) 
  131. 440))
  132.  
  133.  
  134. ; function used to normalize noise and tick clicks
  135. ; this function is necessary because filtering 
  136. ; changes amplitude of filtered noise clicks
  137. (defun normalize (sound)
  138. (setf peak-level (peak sound ny:all))
  139. (scale (/ 1.0 peak-level) sound))
  140.  
  141.  
  142. ; make one measure
  143. (setf measure (stretch-abs ticklen (mult 0.75 
  144. ; pwl is used to add fast [5ms] fade-in and fade-out of clicks
  145. (pwl 0 0 0.005 1 0.995 1 1 0 1)
  146. (cond
  147. ((= click-type 1) ; ping accented clicks
  148. (osc high))
  149. ((= click-type 2) ; noise accented clicks
  150. (normalize (lowpass2 (noise 1) (step-to-hz high) q)))
  151. ((= click-type 3) ; tick accented clicks
  152. (normalize (drip (step-to-hz high)))) ))))
  153. (dotimes (x (- sig 1))
  154.   (setf measure (sim measure
  155.                      (at (* beatlen (+ x 1))                 
  156.                          (stretch-abs ticklen (mult 0.5 
  157. ; again, pwl adds 5ms fade-in and fade-out to clicks
  158. (pwl 0 0 0.005 1 0.995 1 1 0 1)
  159. (cond
  160. ((= click-type 1) ;ping tone unaccented clicks
  161. (osc low))
  162. ((= click-type 2) ; noise unaccented clicks
  163. (normalize (lowpass2 (noise 1) (step-to-hz low) q)))
  164. ((= click-type 3) ; tick unaccented clicks
  165. (normalize (drip (step-to-hz low)))) )))))))
  166. ; make the measure exactly the right length
  167. (setf measure (sim measure
  168.                    (stretch-abs (* sig beatlen) (const 0.0))))
  169.  
  170. ; loop measure n [measures-1] times
  171. (setf result measure)
  172. (dotimes (x (- measures 1))
  173.   (setf result (seq result measure)))
  174. ; add time offset to result,
  175. ; if offset > 0 seconds
  176. (setf result (if (= offset 0) result
  177. (sim (s-rest offset) (at-abs offset (cue result)))))
  178.  
  179. ; return [click track] result
  180. result
  181.  
  182. ) ; end t
  183. ) ; end cond
  184.  
  185. ; from previous commit:
  186. ; arch-tag: 73fbc0e9-548b-4143-b8ac-13437b9154a7
  187.  
  188.  
  189.